home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 20
/
Cream of the Crop 20 (Terry Blount) (1996).iso
/
bbs
/
tigerfix.zip
/
WTCHNEWS.PRG
< prev
next >
Wrap
Text File
|
1996-05-22
|
30KB
|
777 lines
*--------------------------------------------------------------------------*
*--------------------------------------------------------------------------*
* *
* PRUNEIN *
* *
* (c) 1993 by Bernal Schooley *
* and Advanced Designs *
* *
* This program is being released as SHAREware! Please REGISTER it if *
* you decide to use it in ANY way. A LOT of work has gone into this *
* and is available to you now because OTHER people have SUPPORTED the *
* development of this and other TDBS software by Advanced Designs. *
* *
* I ask YOU to be among those who support this and future developments *
* by REGISTERING PRUNE. Registration is ONLY $25.00 and will allow *
* you to recieve technical support and will give you a feeling of *
* satisfaction in knowing that your supporting the efforts of a *
* struggling third party TDBS developer. ;) *
* *
* Thank you! *
* --Bernal Schooley *
* Advanced Designs *
* 217-344-9145 (voice) *
* 217-367-1710 (support bbs) *
* bernal@unity.com (internet) *
* *
*--------------------------------------------------------------------------*
*--------------------------------------------------------------------------*
* *
* If you need additional function added to this program and are unable, *
* or simply don't have enough time, to do it yourself, you may call *
* Bernal Schooley for a quote on custom programming services! Average *
* hourly rates for short to medium term contracts are $40.00. This amount *
* can vary based on complexity, onsite or offsite, and length of overall *
* contract. *
* *
*--------------------------------------------------------------------------*
*--------------------------------------------------------------------------*
CLEAR
** Load path variables from the TIGER.CTL file
FOPEN handle "\TBBS\TIGER.CTL" 10 FMAXLEN()
FLFIND handle pos "UUCPIN:" 1
FLREAD handle bytes data
uucpin = UPPER(LTRIM(RTRIM(CRTRIM(SUBSTR(data,AT("UUCPIN:",UPPER(data))+8)))))
FSEEK handle pos 0 0
FLFIND handle pos "UUCPIN-STAGE:" 1
FLREAD handle bytes data
stagein = UPPER(LTRIM(RTRIM(CRTRIM(SUBSTR(data,AT("UUCPIN-STAGE:",UPPER(data))+14)))))
FSEEK handle pos 0 0
FLFIND handle pos "HOST:" 1
FLREAD handle bytes data
host = UPPER(LTRIM(RTRIM(CRTRIM(SUBSTR(data,AT("HOST:",UPPER(data))+6)))))
FSEEK handle pos 0 0
FLFIND handle pos "UUCPNAME:" 1
FLREAD handle bytes data
uucpname = UPPER(LTRIM(RTRIM(CRTRIM(SUBSTR(data,AT("UUCPNAME:",UPPER(data))+10)))))
FCLOSE handle
** Check for TIGRBUSY or MAILBUSY flags
DO WHILE .T.
IF FILE(stagein+"TIGRBUSY") .OR. FILE(uucpin+"TIGRBUSY")
CLEAR
? "Directories in use..."
? "PRUNEOUT waiting on TIGRBUSY flags..."
ELSE
IF FILE(stagein+"MAILBUSY") .OR. FILE(uucpin+"MAILBUSY")
CLEAR
? "Directories in use..."
? "PRUNEOUT waiting on MAILBUSY flags..."
ELSE
EXIT
ENDIF
ENDIF
?
? "(Press [A] to abort or [D] to delete busy flags and begin.)"
char = INKEY(10)
IF char = 65 .OR. char = 97
QUIT
ENDIF
IF char = 68 .OR. char = 100
IF FILE(stagein+"TIGRBUSY")
temp = stagein + "TIGRBUSY"
ERASE &temp
ENDIF
IF FILE(uucpin+"TIGRBUSY")
temp = uucpin + "TIGRBUSY"
ERASE &temp
ENDIF
IF FILE(stagein+"MAILBUSY")
temp = stagein + "MAILBUSY"
ERASE &temp
ENDIF
IF FILE(uucpin+"MAILBUSY")
temp = uucpin + "MAILBUSY"
ERASE &temp
ENDIF
EXIT
ENDIF
ENDDO
** All clear... write busy files to lock directories and begin
? "PRUNEIN - Working..."
in_busy = uucpin+"MAILBUSY"
out_busy = stagein+"MAILBUSY"
FCREATE handle &in_busy 3
FCLOSE handle
FCREATE handle &out_busy 3
FCLOSE handle
** Load "keep" array from PRUNE.CFG for use while pruning
max = 20
PUBLIC keep[max]
keep[1] = "From:"
keep[2] = "Reply-To:"
keep[3] = "Subject:"
FOPEN handle PRUNE.CFG 10 FMAXLEN()
FLFIND handle pos "PRUNE-METHOD:" 1
FLREAD handle bytes data
method = UPPER(LTRIM(RTRIM(CRTRIM(SUBSTR(data,AT("PRUNE-METHOD:",UPPER(data))+14)))))
FSEEK handle pos 0 0
FLFIND handle pos "ACCOUNTING:" 1
FLREAD handle bytes data
accounting = UPPER(LTRIM(RTRIM(CRTRIM(SUBSTR(data,AT("ACCOUNTING:",UPPER(data))+12)))))
** More variables could be loaded from the CFG file by adding code like
** the following:
*
* FSEEK handle pos 0 0
* FLFIND handle pos "[another keyword]:" 1
* FLREAD handle bytes data
* [new variable] = UPPER(LTRIM(RTRIM(CRTRIM(SUBSTR(data,AT("[keyword as above]:",UPPER(data))+14)))))
FSEEK handle pos 0 0
FLFIND handle pos "KEEP:" 1
FLREAD handle bytes data
FLREAD handle bytes data
top = 3
DO WHILE data # "ENDKEEP:" .AND. bytes > 0 .AND. top < max
top = top + 1
keep[top] = LTRIM(RTRIM(CRTRIM(data)))
FLREAD handle bytes data
ENDDO
FCLOSE handle
** Perform pruning on all .D files in the stagein directory
xfile = FINDFIRST(fnd_nxt, stagein+"*.X")
xfilep = stagein+xfile
DO WHILE LEN(xfile) > 0
** open the .X file
FOPEN handle &xfilep 10 FMAXLEN()/2
** Read "F" line to find the file name
FLFIND handle pos "F "
IF pos < 1
FCLOSE handle
tofile = STUFF(xfilep,AT(".X",xfilep),2,".X!!")
RENAME &xfilep TO &tofile
xfile = FINDNEXT(fnd_nxt)
xfilep = stagein+xfile
LOOP
ENDIF
FLREAD handle bytes data
data = RTRIM(CRTRIM(data))
IF LEN(data) < 6 .OR. .NOT. "D." $ UPPER(data)
FCLOSE handle
tofile = STUFF(xfilep,AT(".X",xfilep),2,".X!!")
RENAME &xfilep TO &tofile
xfile = FINDNEXT(fnd_nxt)
xfilep = stagein+xfile
LOOP
ENDIF
** calculate the .D file name
dfile = RTRIM(CRTRIM(SUBSTR(data,AT("D.",UPPER(data))+2)))
** Calculate the first letter of a .D waffle file *******
y = 1
tryhost = .T.
tryuucp = .T.
lenh = LEN(host)
lenu = LEN(uucpname)
DO WHILE y > 0
IF y <= lenh .AND. tryhost
IF UPPER(LEFT(dfile,1)) = SUBSTR(host,y,1)
dfile = SUBSTR(dfile,2)
y = y + 1
LOOP
ELSE
IF tryuucp
tryhost = .F.
ELSE
exit
ENDIF
ENDIF
ELSE
tryhost = .F.
IF .NOT. tryuucp
exit
ENDIF